home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
baswiz19.zip
/
BW$BAS.ZIP
/
G2LODPCX.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-29
|
3KB
|
88 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' | The BASIC Wizard's Library |
' | |
' +----------------------------------------------------------------------+
DECLARE FUNCTION GetBit0% (BYVAL ASeg%, BYVAL AOfs%, BitNr&)
DECLARE SUB SetBit0 (BYVAL ASeg%, BYVAL AOfs%, BitNr&, BYVAL BitVal%)
DEFINT A-Z
SUB G2LoadPCX (File$, Image(), ErrCode)
DIM SByte AS STRING * 1
ErrCode = 0
IF INSTR(File$, ".") THEN
FileName$ = File$
ELSE
FileName$ = File$ + ".PCX"
END IF
FileNr = FREEFILE
OPEN FileName$ FOR BINARY AS FileNr LEN = 1024
GET FileNr, 1, SByte
IF ASC(SByte) <> 10 THEN ' make sure it's PCX
ErrCode = -1
CLOSE FileNr
EXIT SUB
END IF
GET FileNr, 66, SByte
Planes = ASC(SByte)
IF Planes > 1 THEN ' must be single plane for SCREEN 2
ErrCode = 2
CLOSE FileNr
EXIT SUB
END IF
GET FileNr, 5, X1
GET FileNr, , Y1
GET FileNr, , X2
GET FileNr, , Y2
DX = X2 - X1 + 1
DY = Y2 - Y1 + 1
IF DX < 1 OR DX > 640 OR DY < 1 OR DY > 200 THEN ' check picture size
ErrCode = 1
CLOSE FileNr
EXIT SUB
END IF
REDIM Image(1 TO (5 + DX * DY) \ 2)
Image(1) = DX
Image(2) = DY
X = 0
Y = 0
BitNr& = 0&
GET FileNr, 128, SByte
CSeg = VARSEG(Colour)
COfs = VARPTR(Colour)
ASeg = VARSEG(Image(3))
AOfs = VARPTR(Image(3))
DO
GET FileNr, , SByte
Colour = ASC(SByte)
IF Colour >= &HC0 THEN
RepeatCount = (Colour AND &H3F)
GET FileNr, , SByte
Colour = ASC(SByte)
ELSE
RepeatCount = 1
END IF
FOR Dupe = 0 TO RepeatCount * 8 - 1
Bit = GetBit0(CSeg, COfs, CLNG(Dupe AND 7))
SetBit0 ASeg, AOfs, BitNr&, Bit
BitNr& = BitNr& + 1&
X = X + 1
IF X >= DX THEN EXIT FOR
NEXT
IF X >= DX THEN
BitNr& = ((BitNr& + 7&) AND &HFFFFFFF8)
X = 0
Y = Y + 1
END IF
LOOP UNTIL Y >= DY
CLOSE FileNr
END SUB